home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 4
/
Apprentice-Release4.iso
/
Languages
/
PowerMacOberon 1.2
/
Source
/
Coco⁄R
/
CRS.Mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1995-08-22
|
8KB
|
209 lines
Syntax10.Scn.Fnt
(* scanner module generated by Coco-R *)
MODULE CRS;
IMPORT Texts, SYSTEM;
CONST
EOL = 0DX;
EOF = 0X;
maxLexLen = 127;
noSym = 38;
ErrorProc* = PROCEDURE (n: INTEGER; pos: LONGINT);
StartTable = ARRAY 128 OF INTEGER;
src*: Texts.Text; (*source text. To be set by the main pgm*)
pos*: LONGINT; (*position of current symbol*)
line*, col*, len*: INTEGER; (*line, column, length of current symbol*)
nextPos*: LONGINT; (*position of lookahead symbol*)
nextLine*, nextCol*, nextLen*: INTEGER; (*line, column, length of lookahead symbol*)
errors*: INTEGER; (*number of errors detected*)
Error*: ErrorProc;
ch: CHAR; (*current input character*)
r: Texts.Reader; (*global reader*)
chPos: LONGINT; (*position of current character*)
chLine: INTEGER; (*current line number*)
lineStart: LONGINT; (*start position of current line*)
apx: INTEGER; (*length of appendix*)
oldEols: INTEGER; (*nr. of EOLs in a comment*)
start: StartTable; (*start state for every character*)
PROCEDURE NextCh; (*return global variable ch*)
BEGIN
Texts.Read(r, ch); INC(chPos);
IF ch = EOL THEN INC(chLine); lineStart := chPos + 1 END
END NextCh;
PROCEDURE Comment(): BOOLEAN;
VAR level, startLine: INTEGER; oldLineStart: LONGINT;
BEGIN (*Comment*)
level := 1; startLine := chLine; oldLineStart := lineStart;
IF (ch ="(") THEN
NextCh;
IF (ch ="*") THEN
NextCh;
LOOP
IF (ch ="*") THEN
NextCh;
IF (ch =")") THEN
DEC(level); oldEols := chLine - startLine; NextCh;
IF level=0 THEN RETURN TRUE END
END;
ELSIF (ch ="(") THEN
NextCh;
IF (ch ="*") THEN
INC(level); NextCh;
END;
ELSIF ch = EOF THEN RETURN FALSE
ELSE NextCh END;
END;
ELSE
IF ch = EOL THEN DEC(chLine); lineStart := oldLineStart END;
DEC(chPos, 2); Texts.OpenReader(r, src, chPos+1); NextCh; RETURN FALSE
END
END;
END Comment;
PROCEDURE Get*(VAR sym: INTEGER);
VAR state: INTEGER; lexeme: ARRAY maxLexLen+1 OF CHAR;
PROCEDURE CheckLiteral;
BEGIN
IF nextLen < maxLexLen THEN lexeme[nextLen] := 0X END;
IF (lexeme[0] >= "A") & (lexeme[0] <= "W") THEN
CASE lexeme[0] OF
| "A": IF lexeme = "ANY" THEN sym := 25
END
| "C": IF lexeme = "CASE" THEN sym := 19
ELSIF lexeme = "CHARACTERS" THEN sym := 11
ELSIF lexeme = "CHR" THEN sym := 22
ELSIF lexeme = "COMMENTS" THEN sym := 14
ELSIF lexeme = "COMPILER" THEN sym := 4
ELSIF lexeme = "CONTEXT" THEN sym := 33
END
| "E": IF lexeme = "END" THEN sym := 10
END
| "F": IF lexeme = "FROM" THEN sym := 15
END
| "I": IF lexeme = "IGNORE" THEN sym := 18
ELSIF lexeme = "IMPORT" THEN sym := 5
END
| "N": IF lexeme = "NESTED" THEN sym := 17
END
| "P": IF lexeme = "PRAGMAS" THEN sym := 13
ELSIF lexeme = "PRODUCTIONS" THEN sym := 7
END
| "S": IF lexeme = "SYNC" THEN sym := 32
END
| "T": IF lexeme = "TO" THEN sym := 16
ELSIF lexeme = "TOKENS" THEN sym := 12
END
| "W": IF lexeme = "WEAK" THEN sym := 27
END
ELSE
END
END;
END CheckLiteral;
BEGIN
WHILE (ch=20X) OR (ch=CHR(9)) OR (ch=CHR(13)) OR (ch=CHR(28)) DO NextCh END;
IF ((ch ="(")) & Comment() THEN Get(sym); RETURN END;
IF ch > 7FX THEN ch := " " END;
pos := nextPos; col := nextCol; line := nextLine; len := nextLen;
nextPos := chPos; nextCol := SHORT(chPos - lineStart); nextLine := chLine; nextLen := 0;
state := start[ORD(ch)]; apx := 0;
LOOP
IF nextLen < maxLexLen THEN lexeme[nextLen] := ch END;
INC(nextLen);
NextCh;
IF state > 0 THEN
CASE state OF
| 1: IF (ch>="0") & (ch<="9") OR (ch>="A") & (ch<="Z") OR (ch>="a") & (ch<="z") THEN
ELSE sym := 1; CheckLiteral; RETURN
END;
| 2: IF (ch<=CHR(12)) OR (ch>=CHR(14)) & (ch<="!") OR (ch>="#") THEN
ELSIF (ch =CHR(34)) THEN state := 3;
ELSE sym := noSym; RETURN
END;
| 3: sym := 2; RETURN
| 4: IF (ch<=CHR(12)) OR (ch>=CHR(14)) & (ch<="&") OR (ch>="(") THEN
ELSIF (ch ="'") THEN state := 3;
ELSE sym := noSym; RETURN
END;
| 5: IF (ch>="0") & (ch<="9") THEN
ELSE sym := 3; RETURN
END;
| 6: IF (ch>="0") & (ch<="9") THEN
ELSE sym := 39; RETURN
END;
| 7: sym := 6; RETURN
| 8: sym := 8; RETURN
| 9: IF (ch =")") THEN state := 22;
ELSE sym := 9; RETURN
END;
| 10: sym := 20; RETURN
| 11: sym := 21; RETURN
| 12: IF (ch =".") THEN state := 21;
ELSE sym := 23; RETURN
END;
| 13: sym := 24; RETURN
| 14: sym := 26; RETURN
| 15: sym := 28; RETURN
| 16: sym := 29; RETURN
| 17: sym := 30; RETURN
| 18: sym := 31; RETURN
| 19: sym := 34; RETURN
| 20: sym := 35; RETURN
| 21: sym := 36; RETURN
| 22: sym := 37; RETURN
| 23: sym := 0; ch := 0X; RETURN
END (*CASE*)
ELSE sym := noSym; RETURN (*NextCh already done*)
END (*IF*)
END (*LOOP*)
END Get;
PROCEDURE GetName*(pos: LONGINT; len: INTEGER; VAR s: ARRAY OF CHAR);
VAR i: INTEGER; r: Texts.Reader;
BEGIN
Texts.OpenReader(r, src, pos);
IF len >= LEN(s) THEN len := SHORT(LEN(s)) - 1 END;
i := 0; WHILE i < len DO Texts.Read(r, s[i]); INC(i) END;
s[i] := 0X
END GetName;
PROCEDURE StdErrorProc* (n: INTEGER; pos: LONGINT);
BEGIN INC(errors) END StdErrorProc;
PROCEDURE Reset* (t: Texts.Text; pos: LONGINT; errProc: ErrorProc);
BEGIN
src := t; Error := errProc;
Texts.OpenReader(r, src, pos);
chPos := pos - 1; chLine := 1; lineStart := 0;
oldEols := 0; apx := 0; errors := 0;
NextCh
END Reset;
BEGIN
start[0]:=23; start[1]:=0; start[2]:=0; start[3]:=0;
start[4]:=0; start[5]:=0; start[6]:=0; start[7]:=0;
start[8]:=0; start[9]:=0; start[10]:=0; start[11]:=0;
start[12]:=0; start[13]:=0; start[14]:=0; start[15]:=0;
start[16]:=0; start[17]:=0; start[18]:=0; start[19]:=0;
start[20]:=0; start[21]:=0; start[22]:=0; start[23]:=0;
start[24]:=0; start[25]:=0; start[26]:=0; start[27]:=0;
start[28]:=0; start[29]:=0; start[30]:=0; start[31]:=0;
start[32]:=0; start[33]:=0; start[34]:=2; start[35]:=0;
start[36]:=6; start[37]:=0; start[38]:=0; start[39]:=4;
start[40]:=12; start[41]:=13; start[42]:=0; start[43]:=10;
start[44]:=0; start[45]:=11; start[46]:=9; start[47]:=0;
start[48]:=5; start[49]:=5; start[50]:=5; start[51]:=5;
start[52]:=5; start[53]:=5; start[54]:=5; start[55]:=5;
start[56]:=5; start[57]:=5; start[58]:=0; start[59]:=7;
start[60]:=19; start[61]:=8; start[62]:=20; start[63]:=0;
start[64]:=0; start[65]:=1; start[66]:=1; start[67]:=1;
start[68]:=1; start[69]:=1; start[70]:=1; start[71]:=1;
start[72]:=1; start[73]:=1; start[74]:=1; start[75]:=1;
start[76]:=1; start[77]:=1; start[78]:=1; start[79]:=1;
start[80]:=1; start[81]:=1; start[82]:=1; start[83]:=1;
start[84]:=1; start[85]:=1; start[86]:=1; start[87]:=1;
start[88]:=1; start[89]:=1; start[90]:=1; start[91]:=15;
start[92]:=0; start[93]:=16; start[94]:=0; start[95]:=0;
start[96]:=0; start[97]:=1; start[98]:=1; start[99]:=1;
start[100]:=1; start[101]:=1; start[102]:=1; start[103]:=1;
start[104]:=1; start[105]:=1; start[106]:=1; start[107]:=1;
start[108]:=1; start[109]:=1; start[110]:=1; start[111]:=1;
start[112]:=1; start[113]:=1; start[114]:=1; start[115]:=1;
start[116]:=1; start[117]:=1; start[118]:=1; start[119]:=1;
start[120]:=1; start[121]:=1; start[122]:=1; start[123]:=17;
start[124]:=14; start[125]:=18; start[126]:=0; start[127]:=0;
END CRS.